home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / classprec.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  9.6 KB  |  353 lines  |  [TEXT/ttxt]
  1. /*
  2.  
  3.    classprec.c
  4.  
  5.    This software is free software; you can redistribute it and/or
  6.    modify it under the terms of the GNU Library General Public
  7.    License as published by the Free Software Foundation; either
  8.    version 2 of the License, or (at your option) any later version.
  9.  
  10.    This software is distributed in the hope that it will be useful,
  11.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13.    Library General Public License for more details.
  14.  
  15.    You should have received a copy of the GNU Library General Public
  16.    License along with this software; if not, write to the Free
  17.    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.    Original copyright notice follows:
  20.  
  21.    Copyright, 1994, Joseph N. Wilson.  All Rights Reserved.
  22.  
  23.    Permission to use, copy, and modify this software and its
  24.    documentation is hereby granted only under the following terms and
  25.    conditions.  Both the above copyright notice and this permission
  26.    notice must appear in all copies of the software, derivative works
  27.    or modified version, and both notices must appear in supporting
  28.    documentation.  Users of this software agree to the terms and
  29.    conditions set forth in this notice.
  30.  
  31.  */
  32.  
  33. #include "classprec.h"
  34.  
  35. #include "error.h"
  36. #include "list.h"
  37.  
  38. /* local functions */
  39. static void print_pnode (Object pnode);
  40. static void print_slist (Object slist);
  41.  
  42. static void construct_slist (Object *sptr, Object class);
  43. static void insert_precedes_arc (Object pred_node, Object succ_node);
  44. static void insert_succeeds_arc (Object succ_node, Object pred_node);
  45. static void record_precedence (Object slist, Object pred_class,
  46.                    Object succ_class);
  47. static void decorate_slist_with_precedence (Object slist, Object class);
  48. static void remove_one_predecessor_arc (Object node, Object node_to_remove);
  49. static void remove_predecessor_arcs (Object node);
  50. static void remove_one_successor_arc (Object node, Object node_to_remove);
  51. static void remove_successor_from_predecessors (Object node);
  52. static void remove_node_from_slist (Object *slist, Object node);
  53. static int direct_superclassp (Object super, Object sub);
  54. static Object find_minimal_elements (Object slist);
  55.  
  56. /* macros */
  57.  
  58. #define MAKE_PNODE(class) (cons (class, cons (make_empty_list(), (cons (make_empty_list(), make_empty_list())))))
  59. #define PNODE_CLASS(pnode)        (CAR (pnode))
  60. #define PNODE_SUCCESSORS(pnode)   (CAR (CDR (pnode)))
  61. #define PNODE_PREDECESSORS(pnode) (CAR (CDR (CDR (pnode))))
  62.  
  63. /* functions */
  64.  
  65. Object
  66. compute_class_precedence_list (Object class)
  67. {
  68.     Object slist, class_list, *candidate_list_ptr;
  69.     Object minimal_element_set, node;
  70.     Object precedence_list_rev;
  71.  
  72.     slist = make_empty_list ();
  73.  
  74.     /* Prepare list S */
  75.     construct_slist (&slist, class);
  76.     decorate_slist_with_precedence (slist, class);
  77.  
  78.     /*
  79.        We now have the slist decorated with all the precedences in
  80.        a graph initially rooted at the node for class.  At each step, we
  81.        remove the appropriate minimal element from the graph
  82.        (there may be more than one), and insert it into the precedence
  83.        list.  The prec list is maintained in reverse order.
  84.  
  85.      */
  86.  
  87.     precedence_list_rev = make_empty_list ();
  88.     minimal_element_set = cons (CAR (slist), make_empty_list ());
  89.     while (PAIRP (minimal_element_set)) {
  90.     if (EMPTYLISTP (CDR (minimal_element_set))) {
  91.         /*
  92.          * There is a unique minimal element in the graph.
  93.          *  Add it to the precedence list, remove it from the
  94.          * predecessors list of all its successors, and remove
  95.          *  it from slist.
  96.          */
  97.         node = CAR (minimal_element_set);
  98.         remove_predecessor_arcs (node);
  99.         precedence_list_rev = cons (PNODE_CLASS (node),
  100.                     precedence_list_rev);
  101.         remove_node_from_slist (&slist, node);
  102.         minimal_element_set = find_minimal_elements (slist);
  103.     } else {
  104.         /*
  105.          * We have more than one minimal element.
  106.          * We must choose the one that has a direct subclass that is
  107.          * furthest to the right in the precedence list.  That is,
  108.          * the one that is closest to the head of precedence_list_rev.
  109.          */
  110.         for (class_list = precedence_list_rev;
  111.          PAIRP (class_list);
  112.          class_list = CDR (class_list)) {
  113.         for (candidate_list_ptr = &minimal_element_set;
  114.              PAIRP (*candidate_list_ptr);
  115.              candidate_list_ptr = &CDR (*candidate_list_ptr)) {
  116.             if (direct_superclassp (PNODE_CLASS (CAR (*candidate_list_ptr)),
  117.                         CAR (class_list))) {
  118.             break;
  119.             }
  120.         }
  121.         if (PAIRP (*candidate_list_ptr)) {
  122.             /* We found the right candidate.
  123.              * Remove the predecessor arcs for this node.
  124.              * Remove it from the slist.
  125.              * Update the precedence list.
  126.              * Update the min. element set
  127.              */
  128.             node = CAR (*candidate_list_ptr);
  129.             remove_predecessor_arcs (node);
  130.             precedence_list_rev = cons (PNODE_CLASS (node),
  131.                         precedence_list_rev);
  132.             remove_node_from_slist (&slist, node);
  133.             *candidate_list_ptr = CDR (*candidate_list_ptr);
  134.             if (EMPTYLISTP (minimal_element_set)) {
  135.             minimal_element_set = find_minimal_elements (slist);
  136.             }
  137.             break;
  138.         }
  139.         }
  140.         if (EMPTYLISTP (class_list)) {
  141.         error ("Whoa!  the class list was empty making precedence list",
  142.                NULL);
  143.         }
  144.     }
  145.     }
  146.     if (PAIRP (slist)) {
  147.     error ("Unable to construct class precedence list", class, NULL);
  148.     }
  149.     /* Cache the result */
  150.     CLASSPRECLIST (class) = list_reverse_bang (precedence_list_rev);
  151.     return CLASSPRECLIST (class);
  152. }
  153.  
  154. static void
  155. construct_slist (Object *sptr, Object class)
  156. {
  157.     Object *tmp_sptr = sptr;
  158.     Object sclist;
  159.  
  160.     while (PAIRP (*tmp_sptr)) {
  161.     if (class == PNODE_CLASS (CAR (*tmp_sptr)))
  162.         break;
  163.     tmp_sptr = &CDR (*tmp_sptr);
  164.     }
  165.     if (EMPTYLISTP (*tmp_sptr)) {
  166.     *tmp_sptr = cons (MAKE_PNODE (class), make_empty_list ());
  167.     }
  168.     for (sclist = CLASSSUPERS (class);
  169.      PAIRP (sclist);
  170.      sclist = CDR (sclist)) {
  171.     construct_slist (sptr, CAR (sclist));
  172.     }
  173. }
  174.  
  175. static void
  176. insert_precedes_arc (Object pred_node, Object succ_node)
  177. {
  178.     add_new_at_end (&PNODE_SUCCESSORS (pred_node), (succ_node));
  179. }
  180.  
  181. static void
  182. insert_succeeds_arc (Object succ_node, Object pred_node)
  183. {
  184.     add_new_at_end (&PNODE_PREDECESSORS (succ_node), pred_node);
  185. /*
  186.  
  187.    PNODE_PREDECESSORS (succ_node) = cons (pred_node,
  188.    PNODE_PREDECESSORS (succ_node));
  189.  */
  190. }
  191.  
  192. static void
  193. record_precedence (Object slist, Object pred_class, Object succ_class)
  194. {
  195.     Object q, p;
  196.  
  197.     /* find nodes associated with pred and succ classes */
  198.     for (q = slist; PNODE_CLASS (CAR (q)) != pred_class; q = CDR (q)) ;
  199.     for (p = slist; PNODE_CLASS (CAR (p)) != succ_class; p = CDR (p)) ;
  200.     insert_precedes_arc (CAR (q), CAR (p));
  201.     insert_succeeds_arc (CAR (p), CAR (q));
  202. }
  203.  
  204. static void
  205. decorate_slist_with_precedence (Object slist, Object class)
  206. {
  207.     Object q, p;
  208.  
  209.     for (q = cons (class, make_empty_list ()), p = CLASSSUPERS (class);
  210.      PAIRP (p);
  211.      q = p, p = CDR (p)) {
  212.     record_precedence (slist, CAR (q), CAR (p));
  213.     }
  214.     for (p = CLASSSUPERS (class); PAIRP (p); p = CDR (p)) {
  215.     decorate_slist_with_precedence (slist, CAR (p));
  216.     }
  217. }
  218.  
  219. static void
  220. remove_predecessor_arcs (Object node)
  221. {
  222.     Object succ_list;
  223.  
  224.     for (succ_list = PNODE_SUCCESSORS (node);
  225.      PAIRP (succ_list);
  226.      succ_list = CDR (succ_list)) {
  227.     remove_one_predecessor_arc (CAR (succ_list), node);
  228.     }
  229. }
  230.  
  231. static void
  232. remove_one_predecessor_arc (Object node, Object node_to_remove)
  233. {
  234.     Object *tmp_ptr;
  235.  
  236.     for (tmp_ptr = &PNODE_PREDECESSORS (node);
  237.      CAR (*tmp_ptr) != node_to_remove;
  238.      tmp_ptr = &CDR (*tmp_ptr)) ;
  239.  
  240.     *tmp_ptr = CDR (*tmp_ptr);
  241.  
  242. }
  243.  
  244. static void
  245. remove_one_successor_arc (Object node, Object node_to_remove)
  246. {
  247.     Object *tmp_ptr;
  248.  
  249.     for (tmp_ptr = &PNODE_SUCCESSORS (node);
  250.      CAR (*tmp_ptr) != node_to_remove;
  251.      tmp_ptr = &CDR (*tmp_ptr)) ;
  252.  
  253.     *tmp_ptr = CDR (*tmp_ptr);
  254.  
  255. }
  256.  
  257. static void
  258. remove_successor_from_predecessors (Object node)
  259. {
  260.     Object pred_list;
  261.  
  262.     for (pred_list = PNODE_PREDECESSORS (node);
  263.      PAIRP (pred_list);
  264.      pred_list = CDR (pred_list)) {
  265.     remove_one_successor_arc (CAR (pred_list), node);
  266.     }
  267. }
  268. static void
  269. remove_node_from_slist (Object *slist, Object node)
  270. {
  271.     Object *tmp_ptr;
  272.  
  273.     tmp_ptr = slist;
  274.     while (PAIRP (*tmp_ptr)) {
  275.     if (CAR (*tmp_ptr) == node) {
  276.         *tmp_ptr = CDR (*tmp_ptr);
  277.         return;
  278.     }
  279.     tmp_ptr = &CDR (*tmp_ptr);
  280.     }
  281.     /*
  282.      * If we get here, then the object being removed has already been
  283.      * removed by virtue of having been encountered as a successor
  284.      * of a class included twice in the inheritance hierarchy
  285.      */
  286. }
  287.  
  288. static int
  289. direct_superclassp (Object super, Object sub)
  290. {
  291.     Object supers;
  292.  
  293.     for (supers = CLASSSUPERS (sub);
  294.      PAIRP (supers);
  295.      supers = CDR (supers)) {
  296.     if (CAR (supers) == super)
  297.         return 1;
  298.     }
  299.     return 0;
  300. }
  301.  
  302. /*
  303.  * I left this in for debugging purposes
  304.  */
  305.  
  306. static void
  307. print_pnode (Object pnode)
  308. {
  309.     Object nlist;
  310.  
  311.     fprintf (stderr, "[%s]\n Successors: ",
  312.          SYMBOLNAME (CLASSNAME (PNODE_CLASS (pnode))));
  313.     for (nlist = PNODE_SUCCESSORS (pnode);
  314.      PAIRP (nlist);
  315.      nlist = CDR (nlist)) {
  316.     fprintf (stderr, "%s ",
  317.          SYMBOLNAME (CLASSNAME (PNODE_CLASS (CAR (nlist)))));
  318.     }
  319.     fprintf (stderr, "\n Predecessors: ");
  320.     for (nlist = PNODE_PREDECESSORS (pnode);
  321.      PAIRP (nlist);
  322.      nlist = CDR (nlist)) {
  323.     fprintf (stderr, "%s ",
  324.          SYMBOLNAME (CLASSNAME (PNODE_CLASS (CAR (nlist)))));
  325.     }
  326.     fprintf (stderr, "\n");
  327. }
  328.  
  329. static void
  330. print_slist (Object slist)
  331. {
  332.     Object p;
  333.  
  334.     for (p = slist; PAIRP (p); p = CDR (p)) {
  335.     print_pnode (CAR (p));
  336.     }
  337. }
  338.  
  339.  
  340. static Object
  341. find_minimal_elements (Object slist)
  342. {
  343.     Object mins = make_empty_list ();
  344.  
  345.     while (PAIRP (slist)) {
  346.     if (EMPTYLISTP (PNODE_PREDECESSORS (CAR (slist)))) {
  347.         mins = cons (CAR (slist), mins);
  348.     }
  349.     slist = CDR (slist);
  350.     }
  351.     return mins;
  352. }
  353.